home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / Module source / Grep < prev    next >
Encoding:
Text File  |  1992-05-22  |  3.0 KB  |  118 lines  |  [TEXT/ttxt]
  1. \ Grep - not a true grep. It does not search for full regular expressions
  2. \  but only a string of symbols in the set of terminals.
  3. \ 10/15/84  rw
  4. \  1/18/85  cbd eliminated coded searches in favor of string
  5. \  2/15/86  cdn restrict file names to print only on match
  6. \  9/02/86  cdn Added case sensitivity option
  7. \  9/16/86  cdn Added text highlighting: bold line #, underline match, --more--
  8. \  9/20/86  cdn Added tab expansion
  9. \ 12/29/90    rfl modified for sarray path
  10. \  5/19/92    rfl now exits more gracefully, and doesn't search yerk folder unless specified
  11. \
  12. \ "grflgs" bits:
  13. \ 0 - case sensitive
  14. \ 1 - egrep patterns (not yet implemented)
  15. \ 2 - pause for screen full
  16.  
  17. :Module grepMod
  18.  
  19. // vol
  20. forget dir
  21.  
  22. String gpattern
  23. String linBuf
  24. String target
  25. 0 value curLin#
  26. 0 value #lines
  27.  
  28. \ pause output if option being used
  29. : more
  30.     grflgs 04 and
  31.     IF    curLin# ?lines 3 - >=
  32.         IF    1 tFace ." --More--" 0 tFace key drop CR
  33.             0 -> curLin#
  34.         THEN
  35.     THEN ;
  36.  
  37. false value getOut
  38. : pause? false -> getOut
  39.     ?terminal IF (key) drop cr .pause (key) cr 0 -> out 32 >
  40.                         IF true ELSE false THEN
  41.                     ELSE false
  42.                     THEN -> getOut ;
  43.  
  44. \ ( -- ) ( VARS: linecount, mybuf )  n.b. also assumes gpattern set
  45. : SearchFile  { \ line# .name? -- }
  46.     0 -> line#  1 -> .name?
  47.     BEGIN    pause?
  48.         topFile 80 readLine: linBuf not getOut not and
  49.     WHILE
  50.         1 ++> line#
  51.         target =: linBuf  start: target
  52.         grflgs 01 and 0= IF uc: target 2drop THEN
  53.         get: gpattern  indexOf: target
  54.         IF    .name?
  55.             IF  more cr getName: topFile type ." :" cr 2 ++> curLin#
  56.                 0 -> .name?
  57.             THEN
  58.             more
  59.             1 tFace    \ bold
  60.             line# 3 .r ." ->" start: linBuf
  61.             0 tFace    \ plain
  62.             dup substr: linBuf type
  63.             4 tFace    \ underline
  64.             dup moveTo: linBuf
  65.             size: gpattern dup substr: linBuf type
  66.             + dup moveTo: linBuf
  67.             0 tFace    \ plain
  68.             size: linBuf swap - substr: linBuf type cr 1 ++> curLin#
  69.         THEN
  70.     REPEAT
  71.     line# ++> #lines
  72. ;
  73.  
  74. \ GREP - Will search through all text
  75. \  files for the string specified in object gpattern; printing out the
  76. \  file name, line number and line for all occurrences of the string it
  77. \  locates.
  78. : (grep)  { addr len \ gcurs dirid -- } false -> getOut
  79.     watchcurs 0 -> #lines 0 -> curLin#
  80.     curs -> gcurs -curs    \ Preserve cursor status
  81.     new: loadFile  new: gpattern new: target
  82.     addr len str255 -base count put: gPattern
  83.     ." Searching for: " print: gPattern CR
  84.     grflgs 01 and IF ." -Case sensitive-" CR
  85.                 ELSE uc: gPattern 2drop THEN
  86.     new: linBuf
  87.     HFS? IF limit: path ELSE 1 THEN 0
  88.     DO    path IF i at: path  name: fFcb
  89.               ELSE fFcb clrfcb
  90.               THEN
  91.         i at: path swap drop 0>
  92.         IF  Filecount 1+ 1
  93.             DO    i getidxfile
  94.                 IF    pad count " System" s= not
  95.                     IF    pad count name: topFile
  96.                         getdirid: ffcb setdirid: topfile
  97.                         openReadOnly: topFile ?error 132
  98.                         GetFileInfo: topFile  drop
  99.                         GetType: topFile txType =
  100.                         IF    searchfile THEN
  101.                         close: topFile drop
  102.                     THEN
  103.                 THEN
  104.         getOut IF Leave THEN
  105.         LOOP
  106.         getOut IF Leave THEN
  107.         THEN
  108.     LOOP
  109.     gcurs -> curs    \ Restore cursor status
  110.     remove: loadFile release: gpattern release: target
  111.     release: linBuf
  112.     cr #lines . ." lines searched." cr  arrowcurs
  113. ;
  114.  
  115. : grep word" count (grep) ;
  116.  
  117. ;Module
  118.